home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 5
/
Aminet 5 - March 1995.iso
/
Aminet
/
util
/
cdity
/
HotScreen.lha
/
HotScreen
/
ScreenShuffle.mod
< prev
next >
Wrap
Text File
|
1994-03-24
|
4KB
|
180 lines
MODULE ScreenShuffle;
(*
KeyPatch 1.0 (13.10.1993)
by Carsten Orthbandt
Compiler: Amiga Oberon 3.0
*)
IMPORT e:Exec,
SelectScreen,
es:ExecSupport,
cx:Commodities,
conv:Conversions,
y:SYSTEM,
str:Strings,
d:Dos,
wb:Workbench,
ol:OberonLib,
I: Intuition,
ie:InputEvent,
u: Utility,
ic:Icon;
TYPE MyStr=ARRAY 254 OF CHAR;
VAR
PopKey:ARRAY 100 OF CHAR;
MyBrk :cx.CxObjPtr;
MyFil :cx.CxObjPtr;
MySnd :cx.CxObjPtr;
MyTrs :cx.CxObjPtr;
NwBrk :cx.NewBroker;
MsPrt :e.MsgPortPtr;
Quit :BOOLEAN;
Shut :BOOLEAN;
Err :LONGINT;
eMsg :e.APTR;
Msg :cx.CxMsgPtr;
MsTp :LONGSET;
MsId :LONGINT;
CxPri :LONGINT;
CxKey :ARRAY 254 OF CHAR;
strn:MyStr;
Signal:LONGSET;
PROCEDURE GetToolTypes;
VAR This:d.ProcessPtr;
wbm:wb.WBStartupPtr;
sptr:e.STRPTR;
MyIcon:wb.DiskObjectPtr;
OCurrentDir:d.FileLockPtr;
BEGIN;
This:=y.VAL(d.ProcessPtr,ol.Me);
CxPri:=0;CxKey:="alt control s";
IF ol.wbStarted THEN
wbm:=ol.wbenchMsg;
OCurrentDir:=This.currentDir;
y.SETREG(0,d.CurrentDir(wbm.argList[0].lock));
MyIcon := ic.GetDiskObject(wbm.argList[0].name^);
y.SETREG(0,d.CurrentDir(OCurrentDir));
IF MyIcon#NIL THEN
sptr := ic.FindToolType(MyIcon.toolTypes,"CX_PRIORITY");
IF sptr#NIL THEN IF conv.StringToInt(sptr^,CxPri) THEN END;END;
sptr := ic.FindToolType(MyIcon.toolTypes,"CX_POPKEY");
IF sptr#NIL THEN COPY(sptr^,CxKey);END;
ic.FreeDiskObject(MyIcon);
END;
END;
END GetToolTypes;
PROCEDURE Disable;
BEGIN;
IF cx.ActivateCxObj(MyBrk,0)#0 THEN END;
END Disable;
PROCEDURE Enable;
BEGIN;
IF cx.ActivateCxObj(MyBrk,1)#0 THEN END;
END Enable;
PROCEDURE Init():BOOLEAN;
VAR ret:BOOLEAN;
BEGIN;
ret:=TRUE;
Shut:=FALSE;
IF ret THEN
MsPrt:=e.CreateMsgPort();
IF MsPrt=NIL THEN ret:=FALSE;END;
IF ret THEN
NwBrk.version:=cx.nbVersion;
NwBrk.name:=y.ADR("HotScreen");
NwBrk.title:=y.ADR("HotScreen 1.0 by HDS");
NwBrk.descr:=y.ADR("Screen list by shortcut");
NwBrk.unique:=SET{0,1};
NwBrk.flags:=SET{};
NwBrk.pri:=SHORT(SHORT(CxPri));
NwBrk.port:=MsPrt;
NwBrk.reservedChannel:=0;
MyBrk:=cx.CxBroker(NwBrk,Err);
IF Err#0 THEN ret:=FALSE;END;
IF ret THEN
MyFil:=cx.CxFilter(y.ADR(CxKey));
MySnd:=cx.CxSender(MsPrt,cx.cxmIEvent);
MyTrs:=cx.CxTranslate(NIL);
IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
cx.AttachCxObj(MyBrk,MyFil);
cx.AttachCxObj(MyFil,MySnd);
cx.AttachCxObj(MyFil,MyTrs);
IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
IF cx.ActivateCxObj(MyBrk,1)#0 THEN ret:=FALSE;END;
IF MyFil=NIL THEN ret:=FALSE;END;
IF MySnd=NIL THEN ret:=FALSE;END;
IF MyTrs=NIL THEN ret:=FALSE;END;
IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
END;END;END;
RETURN (ret);
END Init;
PROCEDURE ShutDown;
BEGIN;
IF MyBrk#NIL THEN cx.DeleteCxObjAll(MyBrk);
REPEAT;UNTIL e.GetMsg(MsPrt)=NIL;END;
IF MsPrt#NIL THEN
e.DeleteMsgPort(MsPrt);END;
END ShutDown;
PROCEDURE CheckCx;
VAR wnp:I.WindowPtr;
scr:I.ScreenPtr;
nwn:I.NewWindow;
BEGIN;
IF MsPrt#NIL THEN
REPEAT;
eMsg:=e.GetMsg(MsPrt);
IF eMsg#NIL THEN
Msg:=y.VAL(cx.CxMsgPtr,eMsg);
MsTp:=cx.CxMsgType(Msg);
MsId:=cx.CxMsgID(Msg);
e.ReplyMsg(eMsg);
IF MsTp=LONGSET{cx.cxmIEvent} THEN
SelectScreen.DoIt;
END;
IF MsTp=LONGSET{cx.cxmCommand} THEN
IF MsId=cx.cmdDisable THEN Disable;END;
IF MsId=cx.cmdEnable THEN Enable;END;
IF MsId=cx.cmdKill THEN Quit:=TRUE;END;
IF MsId=cx.cmdUnique THEN Quit:=TRUE;END;
END;
END;
UNTIL eMsg=NIL;
END;
END CheckCx;
BEGIN;
GetToolTypes;
IF Init() THEN
Enable;
CheckCx;
REPEAT;
e.WaitPort(MsPrt);
CheckCx;
UNTIL Quit;
END;
ShutDown;
END ScreenShuffle.